home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2002 November / SGI Freeware 2002 November - Disc 1.iso / dist / fw_exmh.idb / usr / freeware / lib / exmh-2.5 / folder.tcl.z / folder.tcl
Text File  |  2002-07-08  |  9KB  |  360 lines
  1. # 
  2. # folder.tcl
  3. #
  4. # Folder operations, minus scan & inc.
  5. #
  6. # Copyright (c) 1993 Xerox Corporation.
  7. # Use and copying of this software and preparation of derivative works based
  8. # upon this software are permitted. Any distribution of this software or
  9. # derivative works must comply with all applicable United States export
  10. # control laws. This software is made available AS IS, and Xerox Corporation
  11. # makes no warranty about the software, its performance or its conformity to
  12. # any specification.
  13.  
  14. proc Folder_Init {} {
  15.     global exmh argc argv mhProfile
  16.     set exmh(target) {}        ;# Name of target, for refile
  17.     set exmh(started) 0        ;# For Folder_Change, the first time
  18.     if {$argc > 0 && \
  19.     [file isdirectory $mhProfile(path)/[lindex $argv 0]]} then {
  20.     #scan named folder
  21.     set exmh(folder) $argv
  22.     } else {
  23.     if [catch {exec folder -fast < /dev/null} f] {
  24.         set exmh(folder) {}
  25.     } else {
  26.         set exmh(folder) $f
  27.     }
  28.     }
  29. }
  30.  
  31. proc Folder_Summary { folder } {
  32.     global mhProfile env
  33.     if [catch {pwd} cwd] {
  34.     Exmh_Status $cwd
  35.     cd
  36.     set cwd [pwd]
  37.     }
  38.     if [catch {cd $mhProfile(path)/$folder}] {
  39.     catch {cd $cwd}
  40.     return "${folder}+ does not exist"
  41.     }
  42.     set low 100000
  43.     set high 0
  44.     set num 0
  45.     if {[catch {glob *} files] == 0} {
  46.     foreach f $files {
  47.         if {[regexp {^[0-9]+$} $f]} {
  48.         if {$f < $low} {
  49.             set low $f
  50.         }
  51.         if {$f > $high} {
  52.             set high $f
  53.         }
  54.         incr num
  55.         }
  56.     }
  57.     }
  58.     catch {cd $cwd}
  59.     if {$num <= 0} {
  60.     return "${folder}+ has no messages"
  61.     } else {
  62.     return "${folder}+ $num msgs ($low-$high)"
  63.     }
  64. }
  65.  
  66. proc Folder_Change {f {msgShowProc Msg_ShowCurrent}} {
  67. #    LogStart "Folder_Change $f"
  68.     Exmh_Debug ****************
  69.     Exmh_Debug Folder_Change $f [time [list  FolderChange $f $msgShowProc]]
  70. }
  71. proc FolderChange {f msgShowProc} {
  72.     global exmh mhProfile ftoc
  73.     if {[string compare [wm state .] normal] != 0} {
  74.     if {$exmh(iconic)} {
  75.         # Ignore once if starting up with -iconic flag
  76.         set exmh(iconic) 0
  77.     } else {
  78.         wm deiconify .
  79.     }
  80.     }
  81.     if {$exmh(started) && [Ftoc_Changes "Change folder"] > 0} {
  82.     # Need to reselect previous button here
  83.     return
  84.     }
  85.     # Trim off leading mail path
  86.     if [regsub ^$mhProfile(path)/ $f {} newf] {
  87.     set f $newf
  88.     }
  89.     if {[string length $f] == 0} {
  90.     return
  91.     }
  92.     if ![file isdirectory $mhProfile(path)/$f] {
  93.     Exmh_Status "Folder $f doesn't exist" purple
  94.     return
  95.     }
  96.     set oldFolder $exmh(folder)
  97.     Exmh_Status "Changing to $f ..."
  98.     if {$f != $exmh(folder)} {
  99.     Exmh_Debug Exmh_CheckPoint [time Exmh_CheckPoint]
  100.     global mhProfile
  101.     set summary [Mh_Folder $f]    ;# Set MH folder state
  102.     } else {
  103.     if {$ftoc(folder) == {} && $exmh(started)} {
  104.         # pseudo-display -> Checkpoint to set cur msg
  105.         # startup -> don't checkpoint (clears cur sequence)
  106.         Exmh_Debug Exmh_CheckPoint [time Exmh_CheckPoint]
  107.         }
  108.     set summary {}
  109.     }
  110.     set exmh(started) 1
  111.     global folderHook
  112.     if [info exists folderHook(leave,$oldFolder)] {
  113.     $folderHook(leave,$oldFolder) $oldFolder leave
  114.     }
  115.     Label_Folder $f $summary
  116.     Fdisp_HighlightCur $f
  117.     Flist_Visited $f
  118.     set exmh(folder) $f
  119.     if {$ftoc(autoSort)} {
  120.     if [Flist_NumUnseen $f] {
  121.         Ftoc_Sort
  122.     }
  123.     }
  124.     Scan_Folder $f 1
  125.     Exmh_Status $f
  126.     # Either Msg_ShowCurrent or Msg_ShowUnseen
  127.     eval $msgShowProc
  128.  
  129.     # Take any required folder-specific action (e.g., for drafts folder)
  130.     if [info exists folderHook(enter,$f)] {
  131.     $folderHook(enter,$f) $f enter
  132.     }
  133.     foreach cmd [info commands Hook_FolderChange*] {
  134.     $cmd $f
  135.     }
  136. }
  137.  
  138. proc Folder_Unseen {} {
  139.     Ftoc_NextFolder
  140. #    Folder_Change [Flist_NextUnseen]
  141. }
  142.  
  143. proc Folder_Target {f} {
  144.     global exmh mhProfile
  145.  
  146.     if ![file isdirectory $mhProfile(path)/$f] {
  147.     Exmh_Status "$mhProfile(path)/$f doesn't exist"
  148.     return 0
  149.     }
  150.     if {$exmh(folder) == $f} {
  151.     Exmh_Status "Target must be different than current" red
  152.     return 0
  153.     }
  154.     Fdisp_HighlightTarget $f
  155.     set exmh(target) $f
  156.     Exmh_Status "$f is target for moves and copies"
  157.     return 1
  158. }
  159. proc Folder_TargetMove { f {moveProc Ftoc_MoveMark} } {
  160.     if [Folder_Target $f] {
  161.     Msg_Move $moveProc
  162.     Fcache_Folder $f
  163.     }
  164. }
  165.  
  166. proc Folder_TargetCopy { f {copyProc Ftoc_CopyMark} } {
  167.     if [Folder_Target $f] {
  168.     Msg_Move $copyProc advance?
  169.     Fcache_Folder $f
  170.     }
  171. }
  172.  
  173. proc Folder_TargetClear {} {
  174.     global exmh
  175.  
  176.     Fdisp_HighlightTarget ""
  177.     set exmh(target) ""
  178.     Exmh_Status "No target set for moves and copies"
  179. }
  180.  
  181.  
  182. proc Folder_Sort { args } {
  183.     global exmh
  184.  
  185.     if {[Ftoc_Changes "Sort"] == 0} then {
  186.     Background_Wait
  187.     Exmh_Status "Sorting folder..." blue
  188.     eval {Mh_Sort $exmh(folder)} $args
  189.      Flist_ResetUnseen $exmh(folder)     ;# unseen sequence might have changed
  190.     Scan_FolderForce
  191.     set id [Mh_Cur $exmh(folder)]
  192.     if {$id != {}} {
  193.         Msg_Change $id
  194.     } else {
  195.         Msg_ClearCurrent
  196.     }
  197.     }
  198. }
  199.  
  200. proc Folder_Previous {} {
  201.     set f [Ftoc_LastFolder]
  202.     if {[string length $f]} {
  203.     Folder_Change $f
  204.     }
  205. }
  206.  
  207. proc Folder_Pack {} {
  208.     global exmh
  209.  
  210.     if {[Ftoc_Changes "Pack"] == 0} then {
  211.     Background_Wait
  212.     Exmh_Status "Packing folder..." blue
  213.     Mh_Pack $exmh(folder)
  214.      Flist_ResetUnseen $exmh(folder)     ;# unseen sequence might have changed
  215.     Scan_FolderForce
  216.     set id [Mh_Cur $exmh(folder)]
  217.     if {$id != {}} {
  218.         Msg_Change $id
  219.     } else {
  220.         Msg_ClearCurrent
  221.     }
  222.     }
  223. }
  224. proc Folder_Commit { {rmmCommit Mh_Rmm} {moveCommit Mh_Refile} {copyCommit Mh_Copy} } {
  225.     busy FolderCommit $rmmCommit $moveCommit $copyCommit
  226.     return 0
  227. }
  228. proc FolderCommit { rmmCommit moveCommit copyCommit } {
  229.     global exmh exwin ftoc
  230.  
  231.     Msg_CheckPoint    ;# Update sequence state
  232.     Ftoc_Commit $rmmCommit $moveCommit $copyCommit
  233.     Exmh_Debug Scan_CacheUpdate [time Scan_CacheUpdate]
  234.  
  235.     if $ftoc(autoPack) {
  236.     Background_Wait    ;# Let folder ops complete
  237.         Folder_Pack    ;# Before packing
  238.     }
  239.     Label_Folder $exmh(folder)
  240. }
  241. # Streamlined Commit called before Folder_Change
  242. proc Folder_CommitType { type } {
  243.     global ftoc exmh
  244.     Exmh_Debug Folder_CommitType $type
  245.     if {[string compare $type "Change folder"] == 0} {
  246.     Msg_CheckPoint
  247.     busy Ftoc_Commit Mh_Rmm Mh_Refile Mh_Copy
  248.     if $ftoc(autoPack) {
  249.         Background_Wait    ;# Let folder ops complete
  250.         Folder_Pack        ;# Before packing
  251.     }
  252.     } else {
  253.     Folder_Commit
  254.     }
  255. }
  256.  
  257. proc Folder_Purge { {folder {}} } {
  258.     global exmh
  259.     if {[string length $folder] == 0} {
  260.     set folder $exmh(folder)
  261.     }
  262.     set uid 0
  263.     while {[file exists [set fn /tmp/exmh.[pid].touch.$uid]]} {
  264.     incr uid
  265.     }
  266.     exec touch $fn
  267.     set now [file mtime $fn]
  268.     File_Delete $fn
  269.  
  270.     global mhProfile
  271.     if ![info exists mhProfile(delprefix)] {
  272.     set mhProfile(delprefix) #
  273.     }
  274.     if ![info exists mhProfile(purgeage)] {
  275.     set mhProfile(purgeage) 7
  276.     }
  277.     set purgesecs [expr $mhProfile(purgeage) * 24 * 60 * 60]
  278.     set n 0
  279.     foreach f [glob -nocomplain $mhProfile(path)/$folder/$mhProfile(delprefix)*] {
  280.     if {[file mtime $f] + $purgesecs < $now} {
  281.         Exmh_Debug Purge $f
  282.         File_Delete $f
  283.         incr n
  284.     }
  285.     }
  286.     if {$n > 0} {
  287.     Exmh_Status "Folder_Purge $folder $n msgs purged"
  288.     }
  289.     return $n
  290. }
  291.  
  292. proc Folder_PurgeAll {} {
  293.     global flist
  294.     set n 0
  295.     foreach f $flist(allfolders) {
  296.     incr n [Folder_Purge $f]
  297.     }
  298.     if {$n > 0} {
  299.     Exmh_Status "Folder_PurgeAll $n msgs purged total"
  300.     }
  301. }
  302.  
  303. proc Folder_PurgeBg { {folderlist {}} } {
  304.     global exmh mhProfile wish
  305.     if {[string length $folderlist] == 0} {
  306.     set folderlist $exmh(folder)
  307.     }
  308.     set uid 0
  309.     while {[file exists [set fn [Env_Tmp]/exmh.[pid].purge.$uid]]} {
  310.     incr uid
  311.     }
  312.     catch {File_Delete}    ;# auto-load it
  313.  
  314.     set out [open $fn w]
  315.     puts $out "wm withdraw ."
  316.     puts $out "source $exmh(library)/folder.tcl"
  317.     puts $out [list set mhProfile(delprefix) $mhProfile(delprefix)]
  318.     puts $out [list set mhProfile(purgeage) $mhProfile(purgeage)]
  319.     puts $out [list set mhProfile(path) $mhProfile(path)]
  320.     puts $out "proc Exmh_Status { s } \{catch \{send \"[winfo name .]\" \[list Exmh_Status \$s]\}\}"
  321.     puts $out "proc Exmh_Debug { args } {}"
  322.     puts $out [list proc File_Delete [info args File_Delete] [info body File_Delete]]
  323.     foreach folder $folderlist {
  324.     puts $out "Folder_Purge $folder"
  325.     }
  326.     puts $out "exec rm $fn"
  327.     puts $out exit
  328.     close $out
  329.     exec $wish -f $fn &
  330. }
  331. proc Folder_PurgeAllBg {} {
  332.     global flist
  333.     Folder_PurgeBg $flist(allfolders)
  334. }
  335.  
  336. # Called when changing messages.  If you are sharing a folder,
  337. # you need to checkpoint state to the file system at each message.
  338.  
  339. proc Folder_CheckPointShared {} {
  340.     global exmh folder
  341.     if {[info exist folder(shared,$exmh(folder))]} {
  342.     Msg_CheckPoint
  343.     }
  344. }
  345. proc Folder_IsShared {folder} {
  346.     global folder
  347.     set folder(shared,$folder) 1
  348. }
  349. proc Folder_FindShared {} {
  350.     global mhProfile
  351.     if {[catch {open $mhProfile(path)/.folders_shared} in]} {
  352.     Exmh_Debug $in
  353.     return
  354.     }
  355.     foreach f [split [read $in] \n] {
  356.     Foldler_IsShared $f
  357.     }
  358.     close $in
  359. }
  360.